home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / fdical.zip / CAL_REP.PRG < prev    next >
Encoding:
Text File  |  1993-01-04  |  3.9 KB  |  136 lines
  1. *    cal_rep.prg
  2. IF DAY(DATE()) > 25
  3.    M->from = ldom(ldom(DATE())+1)
  4. ELSE
  5.    M->from = ldom(DATE())
  6. ENDIF
  7.  
  8. DO BOX WITH 7,6,12,65,[Calendar Report],.F.
  9. @12,10 SAY [Month ending ] GET M->from
  10. @24,0
  11. READ
  12. escbreak()
  13.  
  14. DO printit
  15. escbreak()
  16.  
  17. DO events
  18.  
  19. DO cal_rep1 WITH []  ,;
  20.                  []  ,;
  21.                  m->from                        ,;
  22.                  [date]                     ,;
  23.                  [Company Calendar for]
  24.  
  25. DO closeIt
  26. CLOSE DATA
  27. RETURN
  28. *** EOF ***
  29.  
  30.  
  31. PROC cal_rep1
  32.    PRIVATE group_key,group
  33.    PARAM group_key,group,mdate,date_field,rep_title1
  34.    mdate = LDOM(mdate)
  35.  
  36.    PRIVATE tab[8], break_bars, mid_bars, top_bars, bot_bars, day_width
  37.    day_width  = 25
  38.    top_bars   = [┌] + REPLIC(REPLIC([─],day_width-1)+[┬],6) + REPLIC([─],day_width-1)+[┐]
  39.    break_bars = [├] + REPLIC(REPLIC([─],day_width-1)+[┼],6) + REPLIC([─],day_width-1)+[┤]
  40.    mid_bars   = [│] + REPLIC(REPLIC([ ],day_width-1)+[│],7)
  41.    bot_bars   = [└] + REPLIC(REPLIC([─],day_width-1)+[┴],6) + REPLIC([─],day_width-1)+[┘]
  42.  
  43.    * shading for weekends:
  44.    mid_bars   = [│] + REPLIC([░], M->day_width-1) + [│] ;
  45.               + REPLIC(REPLIC([ ],day_width-1)+[│],5) ;
  46.               + REPLIC([░], M->day_width-1) + [│]
  47.  
  48.    tab[1]     = 0
  49.    FOR i  = 2 TO 8
  50.       tab[i] = tab[i-1] + M->day_width
  51.    NEXT i
  52.  
  53.    week_width = 132   && sideways at 12 CPI
  54.    *------------start the report----------------------------------------
  55.    ?? sideways
  56.    rep_title1 = rep_title1 + [ ] + CMON(mdate)+STR(YEAR(mdate),5,0)
  57.    @ PROW()+0,1 SAY CENTER(M->rep_title1, week_width)
  58.    ?? condense
  59.  
  60.    *----------print top bar and day names-----------------------------
  61.    @ PROW()+3,tab[1] SAY top_bars
  62.    @ PROW()+1,tab[1] SAY mid_bars
  63.    FOR i = 1 TO 7
  64.       @ PROW(),tab[i]   SAY CENTER(CDOW(CTOD([01/01/1989])+i-1),M->day_width)
  65.       @ PROW(),tab[i]+1 SAY REPLIC([░], M->day_width-1)    && shading
  66.    NEXT i
  67.  
  68.  
  69.    first_day = mdate - DAY(mdate) + 1  && first day of month
  70.    this_date = first_day
  71.    PRIVATE day_nums[7], dates[7], line1[7], line2[7]
  72.  
  73.    DO WHIL this_date <= mdate
  74.       AFILL(day_nums ,0)
  75.       print_day = DAY(this_date)
  76.       FOR i = MAX(1,DOW(this_date)) TO 7
  77.         day_nums[i] = IF(print_day <= DAY(Mdate),print_day,0)
  78.         print_day   = print_day + 1
  79.       NEXT i
  80.       *------------------- print the whole week of day numbers-------------
  81.       @ PROW()+1,tab[1] SAY break_bars
  82.  
  83.       @ PROW()+1,tab[1] SAY mid_bars
  84.       FOR i = 1 TO 7
  85.          @ PROW(),tab[i]+1 SAY day_nums[i] PICT [@Z 99]
  86.       NEXT i
  87.       @ PROW()+1,tab[1] SAY mid_bars   &&  a blank line
  88.  
  89.  
  90.       *----------fill array of seven dates of the week---------------------
  91.       AFILL(dates ,[])
  92.       this_week = .T.
  93.       DO WHIL this_week .AND. this_date <= mdate
  94.          dates[DOW(this_date)] = this_date
  95.          this_date = this_date + 1
  96.          this_week = (DOW(this_date) > 1)
  97.       ENDDO
  98.  
  99.       *--------print the data------------------------------------------------
  100.       more_lines = .T.
  101.       line_num   =  0
  102.       DO WHIL more_lines   && no restriction on line numbers
  103.          more_lines = .F.
  104.          line_num = line_num + 1
  105.          AFILL(line1,[])
  106.          AFILL(line2,[])
  107.          FOR i = 1 TO 7
  108.             IF ! EMPTY(dates[i])
  109.                SEEK M->group + DTOS(dates[i])
  110.                SKIP (line_num - 1)
  111.                IF &date_field = dates[i] .AND. ! OFF()
  112.                   more_lines  = .T.
  113.                   line1[i] = TRIM(whom)+ [ ] + event
  114.                ENDIF
  115.             ENDIF
  116.          NEXT i
  117.          @ PROW()+1,tab[1] SAY mid_bars
  118.          FOR i = 1 TO 7
  119.             @ PROW(),tab[i]+1 SAY line1[i]
  120.          NEXT i
  121.       ENDDO
  122.  
  123.       *   blank lines up to 4 per week:
  124.       FOR i = line_num TO 4
  125.          @ PROW()+1,tab[1] SAY mid_bars
  126.       NEXT i
  127.  
  128.    ENDDO
  129.  
  130.    *---------print bottom bars at end of month
  131.    @ PROW()+1,tab[1] SAY bot_bars
  132. RETURN
  133.  
  134.  
  135.  
  136.